perm filename PTRBIN[D,SYS] blob
sn#195724 filedate 1977-05-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE PTRBIN - TEST PTR BINARY MODE.
C00006 ENDMK
C⊗;
TITLE PTRBIN - TEST PTR BINARY MODE.
PTR←←1
PTP←←2
A←1
B←2
C←3
D←4
BINWRD: 0
BINBYT: 0
OBUF: BLOCK 3
IBUF: BLOCK 3
BEGIN: RESET
OUTSTR [ASCIZ/TYPE Y TO PUNCH A TEST TAPE: /]
INCHWL A
CLRBFI
CAIE A,"Y"
CAIN A,"Y"+40
JRST PNCHT
RT: SETOM REALBI# ;ASSUME REAL BINARY.
OUTSTR [ASCIZ/
MOUNT TAPE IN READER. TYPE CR TO CONTINUE. TYPE Y TO SIMULATE BINARY MODE. /]
INCHWL A
CAIE A,"Y"
CAIN A,"Y"+40
SETZM REALBI ;SIMULATE
CLRBFI
INIT PTR,13
'PTR '
IBUF
HALT RT
INBUF PTR,2
SKIPN REALBI
SETSTS PTR,10 ;SIMULATE BINARY MODE
MOVE A,[POINT 6,BINWRD]
MOVEM A,BINBYT
JSR PATINI
RLOOP: JSR PATGEN ;GENERATE A WORD. SKIPS UNLESS EOF
JRST REOF
JSR RTAPE ;READ A WORD FROM THE TAPE
JRST UEOF
CAMN A,B
JRST RLOOP
OUTSTR [ASCIZ/FAILED. CORRECT WORD IN A. WORD READ IN B.
/]
STOP: JRST RLOOP
UEOF: OUTSTR [ASCIZ/PREMATURE END OF TAPE.
/]
HALT RT
REOF: JSR RTAPE
JRST TAPOK
OUTSTR [ASCIZ/TAPE TOO LONG
/]
HALT REOF
XEOF: OUTSTR [ASCIZ/EOF WHEN A PARTIAL WORD HAD BEEN ACCUMULATED.
/]
HALT BEGIN
TAPOK: MOVE B,BINBYT
CAME B,[POINT 6,BINWRD]
JRST XEOF
OUTSTR [ASCIZ/TAPE OK
/]
CLOSE PTR,
RELEAS PTR,
JRST RT
RTAPE: 0
RTAP0: SOSG IBUF+2
IN PTR,
JRST RTAP1
STATZ 1,760000
JRST @RTAPE ;EOF.
OUTSTR [ASCIZ/TAPE INPUT ERROR.
/]
HALT .+1
SETSTS PTR,13
JRST RTAP0
RTAP1: ILDB B,IBUF+1
SKIPN REALBI ;SKIP IF DOING REAL BINARY MODE.
JRST RTAP2 ;SIMULATED BINARY MODE
AOS RTAPE
JRST 2,@RTAPE
RTAP2: TRNE B,200 ;SKIP IF HOLE 8 OFF (REJECT)
TRNE B,100 ;SKIP IF HOLE 7 OFF (ACCEPT)
JRST RTAP0 ;REJECT BYTE.
IDPB B,BINBYT ;STORE BYTE
MOVE B,BINBYT
CAME B,[POINT 6,BINWRD,35] ;WORD READY YET?
JRST RTAP0 ;NO.
MOVE B,[POINT 6,BINWRD] ;YES. RESET BYTE POINTER
MOVEM B,BINBYT
MOVE B,BINWRD
AOS RTAPE
JRST 2,@RTAPE
PNCHT: INIT PTP,13
'PTP '
OBUF,,
HALT PNCHT
OUTBUF PTP,2
JSR PATINI
PLOOP: JSR PATGEN ;GENERATE A WORD. SKIPS UNLESS EOF
JRST PEOF ;TIME TO CLOSE PTP
JSR PTAPE ;READ A WORD FROM THE TAPE
JRST PLOOP
PEOF: CLOSE PTP,
RELEAS PTP,
JRST RT
PTAPE: 0
SOSG OBUF+2
OUTPUT PTP,
IDPB A,OBUF+1
JRST @PTAPE
PATINI: 0
MOVEI A,1
MOVEM A,PAT#
SETOM WRC#
JRST @PATINI
PATGEN: 0
AOS A,WRC
CAILE A,=2000
JRST @PATGEN
AOS PATGEN
TRNE A,37 ;NON ZERO WORDS ONLY AT MULTIPLES OF 40
JRST [MOVEI A,0
JRST @PATGEN]
MOVE A,PAT
ROT A,1
TLNN A,400000
TRC A,1
SETCAM A,PAT
JRST @PATGEN
END BEGIN